home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 23.zip / BS1 part 23 / Hisoft Basic v1.03 disk 2.adf / Video / VideoIFF.BAS < prev    next >
BASIC Source File  |  1988-12-03  |  10KB  |  449 lines
  1. ' HiSoft BASIC version:
  2. ' label Select has been changed to XSelect
  3. ' label Loop has been changed to XLoop
  4. rem $option v-
  5.  
  6. Setup:
  7.   Colors=5
  8.   d=15 : MaxColors=(2^Colors)-1 
  9.   TextColor=1
  10.   SCREEN CLOSE 2
  11.   SCREEN 2,320,200,Colors,1 : WINDOW 2,"Videotitle",,28,2
  12.   DIM Text$(d),Colormatrix(31,3),Move(d),Speed(d)
  13.   Filler$=STRING$(16,"-")
  14.   Colormatrix(1,1)=15
  15.   Colormatrix(1,2)=15
  16.   Colormatrix(1,3)=15
  17.  
  18. Begin:
  19.   PRINT "Videotitle-Program"
  20.   PRINT "by Hannes R"CHR$(252)"gheimer"
  21.   PRINT
  22.  
  23. XSelect:
  24.   PRINT "Select:"
  25.   PRINT "1  Enter Text"
  26.   PRINT "2  Read Object"
  27.   PRINT "3  Move Object"
  28.   PRINT "4  Define Color"
  29.   PRINT "5  Show Title"
  30.   PRINT "6  Load Background Picture"
  31.   PRINT "7  Read title sequence"
  32.   PRINT "8  Store title sequence"
  33.   PRINT 
  34.  
  35. Query:
  36.   LOCATE 13,1
  37.   PRINT "Enter number:";
  38.   INPUT a$
  39.   a$=LEFT$(a$,1)
  40.   IF a$<"1" OR a$>"8" THEN BEEP: GOTO Query
  41.   IF a$="1" THEN EnterText
  42.   IF a$="2" THEN ReadObject
  43.   IF a$="3" THEN DefineMoveObject
  44.   IF a$="4" THEN DefineColor
  45.   IF a$="5" THEN ShowTitle
  46.   IF a$="6" THEN SetupScreen
  47.   IF a$="7" THEN ReadTitle
  48.   IF a$="8" THEN StoreTitle
  49.   GOTO Query
  50.   
  51.   
  52. EnterText:
  53.   CLS:PRINT "How many lines" : INPUT "of text (1-15)";NoofLines$
  54.   IF NoofLines$= "" THEN CLS: GOTO Begin
  55.   NoofLines=VAL(NoofLines$)
  56.   IF NoofLines<1 OR NoofLines>15 THEN BEEP: GOTO EnterText
  57.   FOR x=1 TO NoofLines
  58.     LINE INPUT "Text:";Text$(x)
  59.   NEXT x : CLS : GOTO Begin
  60.  
  61. ReadObject:
  62.   CLS
  63.   PRINT "Enter the name of the" : PRINT "object you want to load."
  64.   INPUT Objname$
  65.   IF Objname$="" THEN CLS : GOTO Begin
  66.   OPEN Objname$ FOR INPUT AS 1
  67.     OBJECT.SHAPE 1,INPUT$(LOF(1),1)
  68.   CLOSE 1
  69.   ObjFlag=1 : CLS : GOTO Begin
  70.  
  71. DefineMoveObject:
  72.   CLS:IF ObjFlag=0 THEN BEEP ELSE Mover
  73.   PRINT "No object currently in memory!"
  74.   PRINT "Press any key."
  75. Pause:
  76.   a$=INKEY$
  77.   IF a$="" THEN Pause
  78.   CLS: GOTO Begin
  79.  
  80. Mover:
  81.   PRINT "Move the object to it's"
  82.   PRINT "starting point using"
  83.   PRINT "the cursor keys."
  84.   PRINT "When located press <RETURN>"
  85.   ox=100 : oy=100 : Destination=0
  86.   OBJECT.HIT 1,0,0
  87.   OBJECT.ON 1
  88.   OBJECT.STOP 1
  89. XLoop:
  90.   a$=INKEY$
  91.   IF a$=CHR$(13) THEN DestDef
  92.   IF a$=CHR$(28) THEN oy=oy-2
  93.   IF a$=CHR$(31) THEN ox=ox-5
  94.   IF a$=CHR$(30) THEN ox=ox+5
  95.   IF a$=CHR$(29) THEN oy=oy+2
  96.   OBJECT.X 1,ox : OBJECT.Y 1,oy
  97.   GOTO XLoop
  98.  
  99. DestDef:
  100.   CLS
  101.   Move(Destination*2+1)=ox : Move(Destination*2+2)=oy
  102.   Destination=Destination+1 : Move(0)=Destination
  103.   IF Destination=7 THEN Enddef
  104.   PRINT "Move the object to location"Destination
  105.   PRINT "<RETURN> = Set another location"
  106.   PRINT "<ESC> = End"
  107. Loop2:
  108.   a$=INKEY$
  109.   IF a$=CHR$(13) THEN DestDef
  110.   IF a$=CHR$(27) THEN Enddef
  111.   IF a$=CHR$(28) THEN oy=oy-2
  112.   IF a$=CHR$(31) THEN ox=ox-5
  113.   IF a$=CHR$(30) THEN ox=ox+5
  114.   IF a$=CHR$(29) THEN oy=oy+2
  115.   OBJECT.X 1,ox : OBJECT.Y 1,oy
  116.   GOTO Loop2
  117.  
  118. Enddef:
  119.   Move(0)=Destination
  120.   OBJECT.OFF 1
  121.   CLS : GOTO Begin
  122.  
  123. DefineColor:
  124.   CLS:PRINT "Color values:"
  125.  
  126.     FOR x=0 TO MaxColors
  127.     IF (x/8)=INT(x/8) THEN PRINT 
  128.     COLOR -(x=0),x
  129.     PRINT x;
  130.     IF x<10 THEN PRINT CHR$(32);
  131.   NEXT x
  132.  
  133. ColorChange:
  134.   LOCATE 7,1:COLOR TextColor,Background
  135.   PRINT "Enter the number of the color"
  136.   PRINT "you want to change."
  137.   PRINT "(e = End)"; : BEEP
  138.   INPUT Answer$
  139.   IF UCASE$(Answer$)="E" THEN AssignColor
  140.   Answer$=LEFT$(Answer$,2)
  141.   ColorNumber=VAL(Answer$)
  142.   IF ColorNumber<0 OR ColorNumber>MaxColors THEN BEEP: GOTO ColorChange
  143.  
  144. RGBRegulator:
  145.   r=Colormatrix(ColorNumber,1)
  146.   g=Colormatrix(ColorNumber,2)
  147.   b=Colormatrix(ColorNumber,3)
  148.   LOCATE 11,1: PRINT "Red:   <7>=- <8>=+ ":PRINT Filler$
  149.   LOCATE 12,r+1 : PRINT CHR$(124);
  150.   LOCATE 13,1: PRINT "Green: <4>=- <5>=+ ":PRINT Filler$
  151.   LOCATE 14,g+1 : PRINT CHR$(124);
  152.   LOCATE 15,1: PRINT "Blue:  <1>=- <2>=+ ":PRINT  Filler$
  153.   LOCATE 16,b+1 : PRINT CHR$(124);
  154.   LOCATE 17,1: PRINT "       <0>=Color o.k."
  155.   PALETTE ColorNumber,r/16,g/16,b/16
  156.  
  157. EnterKeys:
  158.   Key$=INKEY$
  159.   IF Key$="" THEN EnterKeys
  160.   IF Key$="7" THEN r=r-1
  161.   IF Key$="8" THEN r=r+1
  162.   IF Key$="4" THEN g=g-1
  163.   IF Key$="5" THEN g=g+1
  164.   IF Key$="1" THEN b=b-1
  165.   IF Key$="2" THEN b=b+1
  166.   IF Key$="0" THEN ColorChange
  167.   
  168.   IF r<0 THEN r=0
  169.   IF r>15 THEN r=15
  170.   IF g<0 THEN g=0
  171.   IF g>15 THEN g=15
  172.   IF b<0 THEN b=0
  173.   IF b>15 THEN b=15
  174.  
  175.   Colormatrix(ColorNumber,1)=r
  176.   Colormatrix(ColorNumber,2)=g
  177.   Colormatrix(ColorNumber,3)=b
  178.   GOTO RGBRegulator
  179.  
  180. AssignColor:
  181.   a=Background : a$="Background"
  182.   GOSUB EnterColor:Background=a
  183.   
  184.   a=TextColor : a$="Text Color"
  185.   GOSUB EnterColor:TextColor=a
  186.   
  187.   a=TextBackground : a$="Text Background"
  188.   GOSUB EnterColor:TextBackground=a
  189.   
  190.   COLOR TextColor,Background
  191.   CLS : GOTO Begin
  192.  
  193.  
  194. EnterColor:
  195.   LOCATE 19,1
  196.   PRINT a$": ";a
  197. Loop3:
  198.   LOCATE 19,1
  199.   PRINT a$; : INPUT Answer$
  200.   Answer=VAL(Answer$)
  201.   IF Answer$="" THEN Answer=.5
  202.   IF Answer<0 OR Answer>MaxColors THEN BEEP : GOTO Loop3
  203.   IF Answer<>.5 THEN a=Answer
  204.   RETURN
  205.  
  206.  
  207. ShowTitle:
  208.   CLS
  209.   PRINT "Press the <RETURN> key"
  210.   PRINT "to begin showing the title."
  211. WaitforKey:
  212.   a$=INKEY$
  213.   IF a$=CHR$(13) THEN CLS : c=10 :GOTO Countdown
  214.   GOTO WaitforKey
  215.  
  216. Countdown:
  217.   LOCATE 10,15 : PRINT c
  218.   c=c-1:IF c<0 THEN StartDisplay
  219.   Tim=INT(TIMER)
  220. Wait2:
  221.   IF INT(TIMER)=Tim THEN Wait2
  222.   GOTO Countdown
  223.  
  224. StartDisplay:
  225.   WIDTH 32 
  226.   COLOR TextColor,Background : CLS
  227.   COLOR TextColor,TextBackground
  228.   IF IFF=1 THEN CALL DrawLoad
  229.   FOR x=1 TO NoofLines
  230.     Text$=LEFT$(Text$(x),32)
  231.     h=INT((32-LEN(Text$))/2)+2
  232.     LOCATE x+17-NoofLines,h : PRINT Text$
  233.   NEXT x
  234.   COLOR TextColor,Background
  235.   IF Move(0)=0 THEN MoveText
  236.      
  237.   OBJECT.X 1,Move(1)
  238.   OBJECT.Y 1,Move(2)
  239.   OBJECT.ON 1
  240.   FOR x=1 TO Move(0)-1
  241.     OBJECT.STOP 1
  242.     GOSUB VelocityCalc
  243.     OBJECT.X 1,Move(x*2-1)
  244.     OBJECT.Y 1,Move(x*2)
  245.     OBJECT.VX 1,Speed(x*2-1)
  246.     OBJECT.VY 1,Speed(x*2)
  247.     OBJECT.HIT 1,0,0
  248.     OBJECT.START 1
  249.     
  250.     Tst=TIMER
  251.  Loop4:
  252.     px=ABS(Move(x*2+1)-OBJECT.X(1))
  253.     py=ABS(Move(x*2+2)-OBJECT.Y(1))
  254.     IF INT(TIMER-Tst)<18 AND (px>15 OR py>15) THEN Loop4
  255.   NEXT x
  256.   OBJECT.OFF 1
  257.    
  258. MoveText:
  259.   Tst=TIMER
  260.   IF Move(0)<>0 THEN Finish
  261.   Wait3:
  262.     IF TIMER-Tst<(2*NoofLines+2) THEN Wait3
  263.   Finish:
  264.     FOR x=1 TO 30 
  265.       SCROLL (1,1)-(630,100),0,3
  266.       SCROLL (1,100)-(630,180),0,-3 
  267.     NEXT x
  268.     COLOR TextColor,Background
  269.   CLS : GOTO Begin
  270.  
  271. VelocityCalc:
  272.   ox=OBJECT.X (1) : oy=OBJECT.Y (1)
  273.   Move(x*2-1)=ox : Move(x*2)=oy
  274.   zx=Move(x*2+1) : zy=Move(x*2+2)
  275.     FOR xx=1 TO 64 STEP .2
  276.       Speed(x*2-1)=CINT((zx-ox)/xx)
  277.       Speed(x*2)=CINT((zy-oy)/xx)
  278.       IF ABS(Speed(x*2-1))<40 AND ABS(Speed(x*2))<40 THEN xx=64
  279.     NEXT xx
  280.   RETURN
  281.  
  282. SetupScreen:
  283.   CLS
  284.   PRINT "Want to load a graphic"
  285.   PRINT "background? (Y/N)"
  286.  
  287. Loop5:
  288.   LOCATE 2,19 : INPUT Answ$
  289.   IF UCASE$(Answ$)="N" THEN IFF=0 : CLS : GOTO Begin
  290.   IF UCASE$(Answ$)="Y" THEN IFF=1 : GOTO EnterName 
  291. GOTO Loop5
  292.  
  293. EnterName:
  294.   PRINT
  295.   PRINT "Enter name:"
  296.   INPUT Nam$
  297.   PRINT 
  298.   PRINT "Use the color table for:"
  299.   PRINT Nam$
  300.   PRINT "Enter (Y/N)";
  301. Loop6:
  302.   LOCATE 9,12 : INPUT Answ$
  303.   IF UCASE$(Answ$)="N" THEN IFFTab=0 : CLS : GOTO Begin
  304.   IF UCASE$(Answ$)="Y" THEN IFFTab=1 : CLS : GOTO Begin
  305. GOTO Loop6
  306.   
  307.  
  308. SUB DrawLoad STATIC
  309. SHARED Colors,Colormatrix(),IFFTab,Nam$
  310.   IF Nam$="" THEN EndLoad 
  311.   OPEN Nam$ FOR INPUT AS 1
  312.     Form$=INPUT$(4,1)
  313.     Length=CVL(INPUT$(4,1))
  314.     IF INPUT$(4,1)<>"ILBM" THEN BEEP : GOTO EndLoad
  315.  
  316. ReadData:
  317.     IF EOF(1) THEN EndLoad
  318.     Chunk$=INPUT$(4,1)
  319.     Length=CVL(INPUT$(4,1))
  320.     IF INT(Length/2)<>(Length/2) THEN Length=Length+1
  321.     IF Chunk$="BMHD" THEN BMHeader
  322.     IF Chunk$="CMAP" THEN ColorMap
  323.     IF Chunk$="BODY" THEN BodyMap
  324.     Dummy$=INPUT$(Length,1)
  325.   GOTO ReadData
  326.  
  327. BMHeader:  
  328.     xd=CVI(INPUT$(2,1))
  329.     IF xd>320 THEN EndLoad
  330.     yd=CVI(INPUT$(2,1))
  331.     IF yd>200 THEN EndLoad
  332.     Dummy$=INPUT$(4,1)
  333.     Bitplane=ASC(INPUT$(1,1))
  334.     Dummy$=INPUT$(11,1)
  335.     Addr=PEEKL(WINDOW(8)+4)+8
  336.     FOR x=0 TO Bitplane-1
  337.       PlaneAddr(x)=PEEKL(Addr+4*x)
  338.     NEXT x
  339.   GOTO ReadData
  340.     
  341. ColorMap:
  342.     FOR x=0 TO (Length/3)-1
  343.       r=(ASC(INPUT$(1,1)) AND 240)/16
  344.       g=(ASC(INPUT$(1,1)) AND 240)/16
  345.       b=(ASC(INPUT$(1,1)) AND 240)/16
  346.       IF IFFTab=1 THEN
  347.         PALETTE x,r/16,g/16,b/16
  348.         Colormatrix(x,1)=r : Colormatrix(x,2)=g : Colormatrix(x,3)=b
  349.       END IF
  350.     NEXT x
  351.     IF INT(Length/3)<>(Length/3) THEN Dummy$=INPUT$(1,1)
  352.   GOTO ReadData
  353.     
  354. BodyMap:
  355.     FOR y1=0 TO 199
  356.       FOR b=0 TO Bitplane-1
  357.         IF b<Colors THEN
  358.           FOR x1=0 TO 9
  359.             POKEL PlaneAddr(b)+4*x1+40*y1,CVL(INPUT$(4,1))
  360.           NEXT x1
  361.         ELSE
  362.           Dummy$=INPUT$(40,1)
  363.         END IF
  364.       NEXT b
  365.     NEXT y1
  366.   GOTO ReadData     
  367.  
  368. EndLoad:
  369. CLOSE 1
  370. END SUB
  371.  
  372. StoreTitle:
  373.   CLS : PRINT "Save as what name:"
  374.   INPUT DatName$
  375.   OPEN DatName$ FOR OUTPUT AS 1
  376.     PRINT #1,NoofLines     : REM Number of text lines
  377.     FOR x=1 TO NoofLines
  378.       WRITE #1,Text$(x)
  379.     NEXT x
  380.     
  381.     PRINT #1,ObjFlag     ' Object loaded?
  382.     WRITE #1,Objname$   ' file name
  383.     
  384.     PRINT #1,Move(0)   ' Number of movements
  385.     FOR x=1 TO Move(0)
  386.       PRINT #1,Move(x)
  387.     NEXT x
  388.     
  389.     PRINT #1,Colors     ' Number of Bitplanes
  390.     FOR x=0 TO 31       ' 32 Colors in IFF-Storage
  391.       PRINT #1,CHR$(Colormatrix(x,1)*16);
  392.       PRINT #1,CHR$(Colormatrix(x,2)*16);
  393.       PRINT #1,CHR$(Colormatrix(x,3)*16);
  394.     NEXT x    
  395.     PRINT #1,Background     ' Text color etc.
  396.     PRINT #1,TextColor
  397.     PRINT #1,TextBackground
  398.     
  399.     PRINT #1,IFF        ' Screen background?
  400.     PRINT #1,IFFTab     ' Change colors?
  401.     WRITE #1,Nam$       ' file name
  402.   CLOSE 1
  403.   CLS
  404. GOTO Begin
  405.  
  406. ReadTitle:
  407.   CLS : PRINT "Name of file to load:"
  408.   INPUT DatName$
  409.   OPEN DatName$ FOR INPUT AS 1
  410.     INPUT #1,NoofLines
  411.     FOR x=1 TO NoofLines
  412.       INPUT #1,Text$(x)
  413.     NEXT x
  414.     
  415.     INPUT #1,ObjFlag
  416.     INPUT #1,Objname$
  417.     
  418.     IF ObjFlag=1 THEN
  419.       OPEN Objname$ FOR INPUT AS 2
  420.         OBJECT.SHAPE 1,INPUT$(LOF(2),2)
  421.       CLOSE 2
  422.     END IF
  423.     
  424.     INPUT #1,Move(0)
  425.     FOR x=1 TO Move(0)
  426.       INPUT #1,Move(x)
  427.     NEXT x
  428.     
  429.     INPUT #1,Color1
  430.     IF Color1<=Colors THEN Colors=Color1
  431.     MaxColors=(2^Colors)-1
  432.     FOR x=0 TO 31
  433.       r=(ASC(INPUT$(1,1)) AND 240)/16
  434.       g=(ASC(INPUT$(1,1)) AND 240)/16
  435.       b=(ASC(INPUT$(1,1)) AND 240)/16
  436.       PALETTE x,r/16,g/16,b/16
  437.       Colormatrix(x,1)=r : Colormatrix(x,2)=g : Colormatrix(x,3)=b
  438.     NEXT x
  439.     INPUT #1,Background
  440.     INPUT #1,TextColor
  441.     INPUT #1,TextBackground
  442.     
  443.     INPUT #1,IFF
  444.     INPUT #1,IFFTab
  445.     INPUT #1,Nam$
  446.   CLOSE 1
  447.   CLS
  448. GOTO Begin    
  449.